home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE12 / WPTOOLS / WPTOOLS1.ZIP / DEMO / MailM / MailU.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-07-04  |  14.3 KB  |  511 lines
  1. unit MailU;
  2.  
  3. interface       
  4.  
  5. {$IFDEF WIN32}
  6. uses
  7.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  8.   StdCtrls, DB, DBTables, ExtCtrls, WPStatus, Wpstat2, WpWinCtr, WPRich,
  9.   WPTbar, Buttons, WPDEFS, ComCtrls, Tabnotbk, WPRuler, Menus;
  10. {$ELSE}
  11. uses
  12.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  13.   StdCtrls, DB, DBTables, ExtCtrls, WPStatus, Wpstat2, WpWinCtr, WPRich,
  14.   WPTbar, Buttons, WPDEFS, Tabnotbk, WPRuler, Menus;
  15. {$ENDIF}
  16.  
  17. type
  18.   TForm1 = class(TForm)
  19.     Panel2: TPanel;
  20.     Button1: TButton;
  21.     Bevel1: TBevel;
  22.     FieldList: TListBox;
  23.     Table1: TTable;
  24.     OpenDialog1: TOpenDialog;    
  25.     Label1: TLabel;
  26.     WPToolBar1: TWPToolBar;
  27.     Button2: TButton;
  28.     MakeInsert: TBitBtn;
  29.     Bevel2: TBevel;
  30.     Label2: TLabel;
  31.     Next: TSpeedButton;
  32.     Prev: TSpeedButton;
  33.     InsDate: TBitBtn;
  34.     TabbedNotebook1: TTabbedNotebook;
  35.     AllRtfText: TWPRichText;
  36.     WPRichText1: TWPRichText;
  37.     WPRuler1: TWPRuler;
  38.     MergeAll: TBitBtn;
  39.     MainMenu1: TMainMenu;
  40.     File1: TMenuItem;
  41.     LoadForm1: TMenuItem;
  42.     SaveForm1: TMenuItem;
  43.     N1: TMenuItem;
  44.     SaveMergedText1: TMenuItem;
  45.     N2: TMenuItem;
  46.     Exit1: TMenuItem;
  47.     WPAltStatusBar1: TWPAltStatusBar;
  48.     Example1: TMenuItem;
  49.     addtablerowwith3columns1: TMenuItem;
  50.     Table3columns1: TMenuItem;
  51.     N6columns1: TMenuItem;
  52.     BitBtn1: TBitBtn;
  53.     procedure Button1Click(Sender: TObject);
  54.     procedure Button2Click(Sender: TObject);
  55.     procedure FieldListClick(Sender: TObject);
  56.     procedure MakeInsertClick(Sender: TObject);
  57.     procedure PrevClick(Sender: TObject);
  58.     procedure NextClick(Sender: TObject);
  59.     procedure WPRichText1GetTextToInsert(Sender: TObject; var p: PChar;
  60.       text: PChar; LenOfAutoText: Integer; tag: Word; c: Char;
  61.       var DoContinue: Boolean);
  62.     procedure InsDateClick(Sender: TObject);
  63.     procedure WPToolBar1IconSelection(Sender: TObject; var Typ: TWpSelNr;
  64.       const str: string; const group, num, index: Integer);
  65.     procedure FormCreate(Sender: TObject);
  66.     procedure MergeAllClick(Sender: TObject);
  67.     procedure LoadForm1Click(Sender: TObject);
  68.     procedure SaveForm1Click(Sender: TObject);
  69.     procedure SaveMergedText1Click(Sender: TObject);
  70.     procedure Exit1Click(Sender: TObject);
  71.     procedure addtablerowwith3columns1Click(Sender: TObject);
  72.     procedure Table3columns1Click(Sender: TObject);
  73.     procedure N6columns1Click(Sender: TObject);
  74.     procedure WPRichText1ProtectedChange(Sender: TObject; text: string;
  75.       Tag: Word);
  76.     procedure BitBtn1Click(Sender: TObject);
  77.   protected
  78.       procedure WMGetMinMaxInfo(var MSG: Tmessage); message WM_GetMinMaxInfo;
  79.   public
  80.     { static data to be used for mailmerging }
  81.   {$IFNDEF WIN32}
  82.     textbuff  : array[0..1024] of Char;
  83.   {$ELSE}
  84.     textbuff : string;   { Delphis huge string }
  85.   {$ENDIF}
  86.     MinWidth  : Integer;
  87.     MinHeight : Integer;
  88.     DidMerge  : Boolean;
  89.   end;
  90.  
  91. var
  92.   Form1: TForm1;
  93.   
  94. implementation
  95.  
  96. {$R *.DFM}
  97.  
  98. procedure TForm1.WMGetMinMaxInfo(var MSG: Tmessage);
  99. Begin
  100.   inherited;
  101.   with PMinMaxInfo(MSG.lparam)^ do
  102.   begin
  103.     with ptMinTrackSize do
  104.     begin
  105.       X := MinWidth;
  106.       Y := MinHeight;
  107.     end;
  108.   end;
  109. end;
  110.  
  111. procedure TForm1.FormCreate(Sender: TObject);
  112. begin
  113.   MinWidth  := 350;     
  114.   MinHeight := Height;
  115. end;
  116.  
  117. procedure TForm1.Button1Click(Sender: TObject);
  118. var
  119.   nam : string;
  120. begin
  121.   if OpenDialog1.Execute then
  122.   begin
  123.      Table1.Active := FALSE;
  124.      nam := OpenDialog1.FileName;
  125.      Table1.DataBaseName :=
  126.         ExtractFilePath(nam);
  127.      Table1.TableName :=
  128.         ExtractFileName(nam);
  129.      try
  130.         Label1.Caption := nam;
  131.         Table1.Active := TRUE;
  132.         Table1.GetFieldNames(FieldList.Items);
  133.         Prev.Enabled := TRUE;
  134.         Next.Enabled := TRUE;
  135.      except
  136.         Label1.Caption := 'cannot open';
  137.      end;
  138.   end;
  139. end;
  140.  
  141. { Switch between Viewmode and Editmode.
  142.   The MailMerge variables (InsertPoints)
  143.   are hidden in Viewmode.
  144.   Note: If you save the text in Viewmode
  145.   the InsertPoints are not saved.
  146.  
  147.   You can save the Text without the inserted
  148.   Text when HideAutomatic = TRUE
  149. }
  150. procedure TForm1.Button2Click(Sender: TObject);
  151. begin
  152.    if not WPRichText1.Readonly then
  153.    begin
  154.      Button2.Caption := 'Viewmode OFF';
  155.      WPRichText1.Readonly := TRUE;
  156.      WPRichText1.HideInsertPoints := TRUE;
  157.    end else
  158.    begin
  159.      Button2.Caption := 'Editmode OFF';
  160.      WPRichText1.Readonly := FALSE;
  161.      WPRichText1.HideInsertPoints := FALSE;
  162.    end;
  163. end;
  164.  
  165. procedure TForm1.FieldListClick(Sender: TObject);
  166. begin
  167.     MakeInsert.Enabled := (FieldList.ItemIndex>=0)
  168.       and  not WPrichText1.Readonly and
  169.       (FieldList.Items.Count>0);
  170. end;
  171.  
  172.  
  173. procedure TForm1.MakeInsertClick(Sender: TObject);
  174. var
  175.   i : Integer;
  176. begin
  177.   i := FieldList.ItemIndex;
  178.   if (i>=0) and not WprichText1.ReadOnly
  179.      and (TabbedNotebook1.PageIndex=0) then
  180.   begin
  181.      { Make an insertpoint:
  182.        InputInsertpoint(c : Char;tag : Word;text : string);
  183.        c = any character. for example '#'
  184.        tag = 1..65535 will be used to distinguish between the points
  185.        text will be merged at once
  186.      }
  187.      WPRichText1.InputInsertPoint('#',i+1,'['+FieldList.Items[i]+']');
  188.      if WPRichText1.Visible then WPRichText1.SetFocus;
  189.   end;
  190. end;
  191.  
  192. procedure TForm1.InsDateClick(Sender: TObject);
  193. var
  194.    a,aa : TAttr;
  195. begin
  196.   if not WprichText1.ReadOnly then
  197.   begin
  198.      { Make an insertpoint:
  199.        InputInsertpoint(c : Char;tag : Word;text : string);
  200.        c = any character. for example '#'
  201.        tag = 1..65535 will be used to distinguish between the points
  202.        text will be merged at once
  203.      }
  204.     a := WPRichText1.Attr;
  205.     aa := a;
  206.     { set the backgrund color }
  207.     a.Color := a.Color + (2 * 16);
  208.     WPRichText1.Attr := a;
  209.     WPRichText1.InputInsertPoint('*',1000,'[DATE]');
  210.     WPRichText1.SetFocus;
  211.     WPRichText1.Attr := aa;
  212.   end;
  213. end;
  214.  
  215. { This procedure will be executed when WPRichText1.MergeText was
  216.   called up. It has to fill in the data which should be inserted.
  217.   You should never call any WPRichText procedure within
  218.   the GetTextToInsert Eventhandler!
  219.   var p: PChar;  This pointer has to be nil or should
  220.                  point to the pchar which has to be inserted.
  221.                  (attention: dont use local arrays)
  222.   text: PChar;   The pointer let you know about the text
  223.                  which follows the insertpoint. You vat all text
  224.                  until lineend by reading this varible. It can be
  225.                  used to do some calculation or to fill in the
  226.                  previous data. (the lenght is then LenOfAutoText)
  227.    LenOfAutoText: Integer;
  228.                  If you want to use the previous data this will give
  229.                  it to you as a string:
  230.                  Copy(StrPas(text),1,LenOfAutoText);
  231.    tag: Word;    The second important varaiable: The tag of the
  232.                  insertpoint.
  233.    c: Char;      Maybe of some use: The Character which shows
  234.                  (colored in red) the insertpoint
  235.    var DoContinue: Boolean
  236.                  If you assign FALSE to DoContinue, the
  237.                  merging will be stoped.
  238.   }
  239. procedure TForm1.WPRichText1GetTextToInsert(Sender: TObject; var p: PChar;
  240.   text: PChar; LenOfAutoText: Integer; tag: Word; c: Char;
  241.   var DoContinue: Boolean);
  242. var
  243.   field : TField;
  244. begin
  245.   if Tag=1000 then { Insert today date }
  246.   begin
  247.      {$IFDEF WIN32}
  248.         TextBuff := DateToStr(Date);
  249.         p := PChar(TextBuff);
  250.      {$ELSE}
  251.         StrPLCopy(textbuff,DateToStr(Date),200);
  252.         p := @(textbuff[0]);
  253.      {$ENDIF}
  254.   end
  255.   else if (Tag>0) and (Tag<=FieldList.Items.Count) and Table1.Active then
  256.   begin
  257.      field := Table1.FieldByName(FieldList.Items.Strings[tag-1]);
  258.      if field<>nil then
  259.      begin
  260.         {$IFDEF WIN32}
  261.            TextBuff := field.AsString;;
  262.            p := Pchar(TextBuff);
  263.         {$ELSE}
  264.            StrPLCopy(textbuff, field.AsString, 1022);
  265.            p := @(textbuff[0]);
  266.         {$ENDIF}
  267.      end;
  268.   end;
  269. end;
  270.  
  271. procedure TForm1.PrevClick(Sender: TObject);
  272. var
  273.   s : TMemoryStream;
  274.   old : Boolean;
  275. begin
  276.   if Table1.Active then
  277.   begin
  278.      Table1.Prior;
  279.      Prev.Enabled := not Table1.BOF;
  280.      Next.Enabled := not Table1.EOF;
  281.      MergeAll.Enabled := not Table1.EOF;
  282.      WPRichtext1.MergeText; { if the CursorPos should not change you may use MergeTextFor(#0,0);   }
  283.      try
  284.        s := TMemoryStream.Create;
  285.        old := WPRichText1.HideInsertPoints;
  286.        WPRichText1.HideInsertPoints := TRUE;
  287.        WPRichText1.SaveToStream(s);
  288.        WPRichText1.HideInsertPoints := old;
  289.        s.Position := 0;
  290.        AllRtfText.CPPosition := $FFFFFF;
  291.        AllRtfText.LoadFromStream(s);   
  292.        DidMerge := TRUE;
  293.      finally
  294.        s.Free;
  295.      end;
  296.   end;
  297. end;
  298.  
  299. procedure TForm1.NextClick(Sender: TObject);
  300. var
  301.   s : TMemoryStream;
  302.   old : Boolean;
  303. begin
  304.   if Table1.Active then
  305.   begin
  306.      Table1.Next;
  307.      Prev.Enabled := not Table1.BOF;
  308.      Next.Enabled := not Table1.EOF;
  309.      MergeAll.Enabled := not Table1.EOF;
  310.      WPRichtext1.MergeText;
  311.      try
  312.        s := TMemoryStream.Create;
  313.        old := WPRichText1.HideInsertPoints;
  314.        WPRichText1.HideInsertPoints := TRUE;
  315.        WPRichText1.SaveToStream(s);
  316.        WPRichText1.HideInsertPoints := old;
  317.        s.Position := 0;
  318.        AllRtfText.CPPosition := $FFFFFF;
  319.        AllRtfText.LoadFromStream(s);
  320.        DidMerge := TRUE;
  321.      finally
  322.        s.Free;
  323.      end;
  324.   end;
  325. end;
  326.  
  327. { please include WPDEFS to the usage }
  328. procedure TForm1.WPToolBar1IconSelection(Sender: TObject;
  329.   var Typ: TWpSelNr; const str: string; const group, num, index: Integer);
  330. begin
  331.   if typ=wptIconSel then
  332.   begin
  333.      if group=WPI_GR_DISK then
  334.      begin if num=WPI_CO_NEW then
  335.            begin
  336.                  if TabbedNotebook1.PageIndex=0 then
  337.                  begin
  338.                    WPRichText1.Clear;
  339.                    WPRichText1.CPPosition := 0;
  340.                  end else
  341.                  begin
  342.                    AllRtfText.Clear;
  343.                    AllRtfText.CPPosition := 0;
  344.                    if Table1.Active then
  345.                    begin Table1.First;
  346.                          MergeAll.Enabled := TRUE;
  347.                          Next.Enabled := TRUE;
  348.                          Prev.Enabled := FALSE;
  349.                    end;
  350.                  end;
  351.                  WPToolBar1.SelectIcon(index,group,num);
  352.            end
  353.            else if num= WPI_CO_EXIT then Close;
  354.      end;
  355.   end else
  356.   if typ=wptIconDeSel then
  357.   begin
  358.  
  359.   end;
  360. end;
  361.  
  362.  
  363. procedure TForm1.MergeAllClick(Sender: TObject);
  364. var
  365.   old : Boolean;
  366.   var i : Longint;
  367. begin
  368.   i := 0;
  369.   if not Table1.Active then exit;
  370.   AllRtfText.HideInsertPoints := TRUE;
  371.   AllRtfText.FastCopyProperties(WPRichText1);
  372.   if MessageBox(0,'Merge all Records in Database?',
  373.         'MailMerge',IDOK)=IDOK then
  374.   try
  375.     while not Table1.EOF do
  376.     begin
  377.      inc(i);
  378.      WPAltStatusBar1.SetString(stStatus,IntToStr(i));
  379.      Table1.Next;
  380.      if not Table1.EOF then
  381.      begin
  382.         WPRichtext1.FastMergeText;
  383.         AllRtfText.Memo.FastAppendText(WPRichText1.Memo.FirstPar);
  384.      end;
  385.     end;
  386.   finally
  387.     { After usage of FastAppendText it is neccessary to call Refresh }
  388.     AllRtfText.Refresh;
  389.     { the usage of FastMergeText makes it necessary to call Refresh }
  390.     WPRichtext1.Refresh;
  391.  
  392.     Prev.Enabled := not Table1.BOF;
  393.     Next.Enabled := not Table1.EOF;
  394.     MergeAll.Enabled := not Table1.EOF;
  395.     DidMerge := TRUE;
  396.   end;
  397. end;
  398.  
  399. procedure TForm1.LoadForm1Click(Sender: TObject);
  400. begin
  401.    WPRichText1.Load;    
  402. end;
  403.  
  404. procedure TForm1.SaveForm1Click(Sender: TObject);
  405. var
  406.   old : Boolean;
  407. begin
  408.   old :=  WPRichText1.HideInsertPoints;
  409.   { WPRichText1.HideInsertPoints has to be FALSE. Otherwise
  410.     the insertpoints won't be saved }
  411.   WPRichText1.HideInsertPoints := FALSE;
  412.   WPRichText1.SaveAs;
  413.   WPRichText1.HideInsertPoints := old;
  414. end;
  415.  
  416. procedure TForm1.SaveMergedText1Click(Sender: TObject);
  417. begin
  418.    AllRtfText.SaveAs;
  419. end;
  420.  
  421. procedure TForm1.Exit1Click(Sender: TObject);
  422. begin
  423.   Close;
  424. end;
  425.  
  426. procedure TForm1.addtablerowwith3columns1Click(Sender: TObject);
  427. var
  428.    CWidth : array[1..5] of Integer;
  429. const
  430.    mult = 255 div 6;
  431. begin
  432.    WPRichText1.Clear;
  433.    CWidth[1] := mult;
  434.    CWidth[2] := mult * 2;
  435.    CWidth[3] := mult * 3;
  436.    WPRichText1.CreateTable(1,3,@Cwidth[1],FALSE);
  437. end;
  438.  
  439. procedure TForm1.Table3columns1Click(Sender: TObject);
  440. var
  441.    CWidth : array[1..5] of Integer;
  442. const
  443.    mult = 255 div 6;
  444. begin
  445.    WPRichText1.Clear;
  446.    CWidth[1] := mult;
  447.    CWidth[2] := mult * 2;
  448.    CWidth[3] := mult * 3;
  449.    WPRichText1.CreateTable(1,3,@Cwidth[1],TRUE);
  450. end;
  451.  
  452. procedure TForm1.N6columns1Click(Sender: TObject);
  453. begin
  454.    WPRichText1.Clear;
  455.    WPRichText1.CreateTable(1,6,nil,TRUE);
  456. end;
  457.  
  458. { property ProtectedProp = [ppIsInsertpoint,ppAutomatic] !
  459.   otherwise this event will not be executed }
  460. procedure TForm1.WPRichText1ProtectedChange(Sender: TObject; text: string;
  461.   Tag: Word);
  462. var
  463.   newstr : String;
  464.   c      : Char;
  465.   field  : TField;
  466.   fieldname : string;
  467. begin
  468.   if text='' then c:=#0 else c := text[1];
  469.   if c = '*' then
  470.   begin
  471.      Application.MessageBox('Cannot change DATE','ProtectedChange - Event',0);
  472.      exit;
  473.   end;
  474.  
  475.   if DidMerge and Table1.Active and (Tag>0) then
  476.   begin
  477.      fieldname := FieldList.Items.Strings[tag-1];
  478.      field := Table1.FieldByName(fieldname);
  479.      if field<>nil then
  480.      begin
  481.        if Field is TStringField then  { Update a Datafield }
  482.        begin
  483.           newstr := Field.AsString;
  484.           if InputQuery('ProtectedChange - Event',
  485.                'Change Datafield [' + fieldname + ']: "' + text+'"',
  486.                newstr) then
  487.           begin
  488.              Table1.Edit;
  489.              Field.AsString := newStr;
  490.              Table1.Post;
  491.              WPRichText1.MergeTextFor('#', tag);
  492.           end;
  493.        end else
  494.        begin
  495.           Application.MessageBox('Cannot edit this Fieldtype','ProtectedChange - Event',0);
  496.        end;
  497.      end;
  498.   end else Application.MessageBox('Please merge data first.','ProtectedChange - Event',0);
  499. end;
  500.  
  501. procedure TForm1.BitBtn1Click(Sender: TObject);
  502. begin
  503.   if not WprichText1.ReadOnly then
  504.   begin
  505.      WPRichText1.InputText(#12+#0);
  506.      WPRichText1.SetFocus;
  507.   end;
  508. end;
  509.  
  510. end.
  511.